home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / WINRES / WINRES.PAS < prev    next >
Pascal/Delphi Source File  |  1994-09-15  |  37KB  |  1,589 lines
  1. unit WinRes;
  2.  
  3. { unit WinRes, Version 1.20.001, Copyright (c) 1993 Matthias Köppe.
  4.  
  5.   winres.scr winres.txt winres.doc
  6. }
  7.  
  8. {$A+,B-,F-,G+,O-,R-,S-,X+}
  9.  
  10. interface
  11.  
  12. uses Objects;
  13.  
  14. type
  15.   MakeIntResource = PChar;
  16.  
  17. { Predefined Resource Types
  18. }
  19. const
  20.   rt_Cursor       = MakeIntResource(1);
  21.   rt_Bitmap       = MakeIntResource(2);
  22.   rt_Icon         = MakeIntResource(3);
  23.   rt_Menu         = MakeIntResource(4);
  24.   rt_Dialog       = MakeIntResource(5);
  25.   rt_String       = MakeIntResource(6);
  26.   rt_FontDir      = MakeIntResource(7);
  27.   rt_Font         = MakeIntResource(8);
  28.   rt_Accelerator  = MakeIntResource(9);
  29.   rt_RCData       = MakeIntResource(10);
  30.   rt_Group_Cursor = MakeIntResource(12);
  31.   rt_Group_Icon   = MakeIntResource(14);
  32.  
  33. type
  34.  
  35. { Old-style EXE header
  36. }
  37.   TExeHeader = record
  38.     Signature: Word;
  39.     LastCount: Word;
  40.     PageCount: Word;
  41.     ReloCount: Word;
  42.     eHdrSize:   Word;
  43.     eMinAbove:  Word;
  44.     eMaxAbove:  Word;
  45.     eInitSS:    Word;
  46.     eInitSP:    Word;
  47.     eCheckSum:  Word;
  48.     eInitPC:    Word;
  49.     eInitCS:    Word;
  50.     eRelocOfs:  Word;
  51.     eOvlyNum:   Word;
  52.     eRelocTab:  Word;
  53.     eSpace:     array[1..30] of Byte;
  54.     eNewHeader: Word;
  55.   end;
  56.  
  57. { New-Style EXE header
  58. }
  59.   TWinHeader = record
  60.     Signature: Word;
  61.     LinkerVer: Word;
  62.     EntryOffs: Word;
  63.     EntrySize: Word;
  64.     ReservedA: array[0..3] of Byte;
  65.     LinkerFlags: Word;
  66.     nDataSeg: Word;
  67.     LocalHeapSize: Word;
  68.     StackSize: Word;
  69.     CSIP: pointer;
  70.     SSSP: pointer;
  71.     nSegEntries: Word;
  72.     nModRefEntries: Word;
  73.     nNonResNameBytes: Word;
  74.     SegTbl: Word;            { offsets from Win header }
  75.     ResourceTbl: Word;
  76.     ResNameTbl: Word;
  77.     ModRefTbl: Word;
  78.     ImpNameTbl: Word;
  79.     NonResNameTbl: LongInt;        { offset from top }
  80.     nMovableEntryPoints: Word;
  81.     ShiftCount: Word;
  82.     nResourceSegs: Word;
  83.     OS: Byte;
  84.     Extra: Byte;
  85.     ReservedB: array[0..7] of Byte;
  86.   End;
  87.  
  88. { Resource information
  89. }
  90.   TNameInfo = record
  91.     rnOffset: Word;            { in alignment units from top }
  92.     rnLength: Word;            { in bytes }
  93.     rnFlags: Word;
  94.     rnID: Word;        { offset from resource table or int value + 8000H }
  95.     rnHandle: Word;
  96.     rnUsage: Word;
  97.   End;
  98.  
  99. { Resource type information
  100. }
  101.   TTypeInfo = record
  102.     rtTypeID: Word;    { offset from resource table or int value + 8000H }
  103.     rtResourceCount: Word;
  104.     rtReserved: array[0..3] of Byte;
  105. {   rtNameInfo: array of TNameInfo;
  106. }  End;
  107.  
  108. { Resource table
  109. }
  110.   TResTable = record
  111.     rscAlignShift: Word;
  112. {   rscTypes: array of TTypeInfo;
  113.     rscEndTypes: Word = 0;
  114.     rscResourceNames: array of Char;
  115.     rscEndNames: Byte = 0;
  116. } End;
  117.  
  118. { Data structures for font resources ***************************************
  119. }
  120.  
  121. { Table entry for raster fonts 2.x
  122. }
  123.   TRasterInfo = record            { Win 2 fonts }
  124.     dcWidth: Word;
  125.     dcOffset: Word;
  126.   End;
  127.  
  128. { Table entry for raster fonts 3.x
  129. }
  130.   TNewRasterInfo = record
  131.     dcWidth: Word;
  132.     dcOffset: LongInt;            { Win 3 fonts }
  133.   End;
  134.  
  135. { Table entry for monospaced vector fonts
  136. }
  137.   TFixedVectorInfo = record
  138.     dcOffset: Word;
  139.   End;
  140.  
  141. { Table entry for proportionally spaced vector fonts
  142. }
  143.   TPropVectorInfo = record
  144.     dcOffset: Word;
  145.     dcWidth: Word;
  146.   End;
  147.  
  148. { Font resource information
  149. }
  150.   TFontInfo = record
  151. { Font dir only
  152. }
  153.     dfResID: Word;
  154.  
  155. { Always present
  156. }
  157.     dfVersion: Word;
  158.     dfSize: LongInt;
  159.     dfCopyright: array[0..59] of Char;
  160.     dfType: Word;            { Lowest Bit = 1 -> Vector Font }
  161.     dfPoints: Word;
  162.     dfVertRes: Word;
  163.     dfHorizRes: Word;
  164.     dfAscent: Word;
  165.     dfInternalLeading: Word;
  166.     dfExternalLeading: Word;
  167.     dfItalic: Byte;
  168.     dfUnderline: Byte;
  169.     dfStrikeOut: Byte;
  170.     dfWeight: Word;
  171.     dfCharset: Byte;
  172.     dfPixWidth: Word;            { 0 if variable-width }
  173.     dfPixHeight: Word;
  174.     dfPitchAndFamily: Byte;        { Lowest Bit = 1 -> variable pitch }
  175.     dfAvgWidth: Word;
  176.     dfMaxWidth: Word;
  177.     dfFirstChar: Byte;
  178.     dfLastChar: Byte;
  179.     dfDefaultChar: Byte;
  180.     dfBreakChar: Byte;
  181.     dfWidthBytes: Word;
  182.     dfDevice: Word;
  183.     dfReserved2: Word;
  184.     dfFace: Word;
  185.     dfReserved3: Word;
  186.     dfBitsPointer: pointer;
  187.     dfBitsOffset: LongInt;
  188.     dfReserved: Byte;
  189.  
  190. { Version 3.x only
  191. }
  192.     dfFlags: Word;
  193.     dfAspace: Word;
  194.     dfBspace: Word;
  195.     dfCspace: Word;
  196.     dfColorPointer: LongInt;
  197.     dfReserved1: Word;
  198.  
  199. { Font dir only
  200. }
  201. {   devicename: array of Char;
  202.     facename: array of Char;
  203.  
  204. { Font resource only
  205. }
  206. {   dfCharTable: array of record
  207.       case Integer of
  208.     Raster:         (dfRasterTbl:      TRasterInfo);
  209.     NewRaster:   (dfNewRasterTbl:   TNewRasterInfo);
  210.     FixedVector: (dfFixedVectorTbl: TFixedVectorInfo);
  211.     PropVector:  (dfPropVectorTbl:  TPropVectorInfo)
  212.     end;
  213.     bitmaps: array of Byte;
  214.     facename: array of Char;
  215.     devicename: array of Char;
  216. }
  217.   End;
  218.  
  219. const
  220.   FontInfoExtraSize = 14;
  221.   FontInfoBaseSize = SizeOf(TFontInfo) - FontInfoExtraSize;
  222.  
  223. type
  224.  
  225. { Font directory
  226. }
  227.   TFontDir = record
  228.     fdCount: Word;
  229. {   fdDir: array of TFontInfo;
  230. } End;
  231.  
  232.  
  233. { Data structures for menu resources ***************************************
  234. }
  235.  
  236. const
  237.   mo_TurboVision    = 0;
  238.   mo_GraphicsVision    = 1;
  239.  
  240. const
  241.   mf_Grayed         = 1;
  242.   mf_Disabled        = 2;
  243.   mf_Checked        = 8;
  244.   mf_PopUp        = 16;
  245.   mf_MenuBarBreak    = 32;
  246.   mf_MenuBreak        = 64;
  247.   mf_End        = 128;
  248.  
  249. type
  250.   TMenuHeader = record
  251.     wVersion: Word;
  252.     wReserved: Word
  253.   End;
  254.  
  255.   TPopUpMenuItem = record
  256.     fItemFlags: Word;
  257. {   szItemText: array of Char
  258. } End;
  259.  
  260.   TNormalMenuItem = record
  261.     fItemFlags: Word;
  262.     wMenuID: Word;
  263. {   szItemText: array of Char
  264. } End;
  265.  
  266. { Data structures for bitmap resources *************************************
  267. }
  268.  
  269. { Bitmap header definition }
  270.  
  271. type
  272.   PBitmap = ^TBitmap;
  273.   TBitmap = record
  274.     bmType: Integer;
  275.     bmWidth: Integer;
  276.     bmHeight: Integer;
  277.     bmWidthBytes: Integer;
  278.     bmPlanes: Byte;
  279.     bmBitsPixel: Byte;
  280.     bmBits: Pointer;
  281.   end;
  282.  
  283. type
  284.   TRGBTriple = record
  285.     rgbtBlue: Byte;
  286.     rgbtGreen: Byte;
  287.     rgbtRed: Byte;
  288.   end;
  289.  
  290. type
  291.   TRGBQuad = record
  292.     rgbBlue: Byte;
  293.     rgbGreen: Byte;
  294.     rgbRed: Byte;
  295.     rgbReserved: Byte;
  296.   end;
  297.  
  298. { Structures for defining DIBs }
  299.  
  300. type
  301.   PBitmapCoreHeader = ^TBitmapCoreHeader;
  302.   TBitmapCoreHeader = record
  303.     bcSize: Longint;              { used to get to color table }
  304.     bcWidth: Word;
  305.     bcHeight: Word;
  306.     bcPlanes: Word;
  307.     bcBitCount: Word;
  308.   end;
  309.  
  310. type
  311.   PBitmapInfoHeader = ^TBitmapInfoHeader;
  312.   TBitmapInfoHeader = record
  313.     biSize: Longint;
  314.     biWidth: Longint;
  315.     biHeight: Longint;
  316.     biPlanes: Word;
  317.     biBitCount: Word;
  318.     biCompression: Longint;
  319.     biSizeImage: Longint;
  320.     biXPelsPerMeter: Longint;
  321.     biYPelsPerMeter: Longint;
  322.     biClrUsed: Longint;
  323.     biClrImportant: Longint;
  324.   end;
  325.  
  326. { Constants for the biCompression field }
  327.  
  328. const
  329.   bi_RGB  = 0;
  330.   bi_RLE8 = 1;
  331.   bi_RLE4 = 2;
  332.  
  333. type
  334.   PBitmapInfo = ^TBitmapInfo;
  335.   TBitmapInfo = record
  336.     bmiHeader: TBitmapInfoHeader;
  337.     bmiColors: array[0..0] of TRGBQuad;
  338.   end;
  339.  
  340. type
  341.   PBitmapCoreInfo = ^TBitmapCoreInfo;
  342.   TBitmapCoreInfo = record
  343.     bmciHeader: TBitmapCoreHeader;
  344.     bmciColors: array[0..0] of TRGBTriple;
  345.   end;
  346.  
  347. type
  348.   PBitmapFileHeader = ^TBitmapFileHeader;
  349.   TBitmapFileHeader = record
  350.     bfType: Word;
  351.     bfSize: Longint;
  352.     bfReserved1: Word;
  353.     bfReserved2: Word;
  354.     bfOffBits: Longint;
  355.   end;
  356.  
  357. { Data structures for string resources *************************************
  358. }
  359. type
  360.   PStringBlock = ^TStringBlock;
  361.   TStringBlock = record
  362.     sbIndex: Word;
  363.     sbSize: Word;
  364.     sbNext: PStringBlock;
  365.     sbData: record end
  366.   End;
  367.  
  368. { Data structures for cursor resources *************************************
  369. }
  370.  
  371. type
  372.   PCursorDirEntry = ^TCursorDirEntry;
  373.   TCursorDirEntry = record
  374.     wWidth: Word;
  375.     wHeight: Word;
  376.     wPlanes: Word;
  377.     wBitCount: Word;
  378.     lBytesInRes: LongInt;
  379.     wImageIndex: Word
  380.   end;
  381.  
  382.   PCursorRes = ^TCursorRes;
  383.   TCursorRes = record
  384.     crHotSpotX: Word;
  385.     crHotSpotY: Word;
  386.     crHeader: TBitmapInfoHeader;
  387. {   crColors: array of TRGBQuad;
  388.     crXOR: array of Byte;
  389.     crAND: array of Byte
  390. } end;
  391.  
  392. type
  393.   PMyCursor = ^TMyCursor;
  394.   TMyCursor = record
  395.     mcHeight: Word;
  396.     mcWidth: Word;
  397.     mcHotSpotX: Word;
  398.     mcHotSpotY: Word;
  399.     mcAND: array[0..127] of Byte;
  400.     mcXOR: array[0..127] of Byte
  401.   end;
  402.  
  403. { Data structures for dialog template resources ***************************
  404. }
  405.  
  406. { Window Styles }
  407.  
  408. const
  409.   ws_Overlapped   = $00000000;
  410.   ws_Popup        = $80000000;
  411.   ws_Child        = $40000000;
  412.   ws_Minimize     = $20000000;
  413.   ws_Visible      = $10000000;
  414.   ws_Disabled     = $08000000;
  415.   ws_ClipSiblings = $04000000;
  416.   ws_ClipChildren = $02000000;
  417.   ws_Maximize     = $01000000;
  418.   ws_Caption      = $00C00000;    { ws_Border + ws_DlgFrame }
  419.   ws_Border       = $00800000;
  420.   ws_DlgFrame     = $00400000;
  421.   ws_VScroll      = $00200000;
  422.   ws_HScroll      = $00100000;
  423.   ws_SysMenu      = $00080000;
  424.   ws_ThickFrame   = $00040000;
  425.   ws_Group        = $00020000;
  426.   ws_TabStop      = $00010000;
  427.  
  428. const
  429.   ws_MinimizeBox = $00020000;
  430.   ws_MaximizeBox = $00010000;
  431.  
  432. const
  433.   ws_Tiled   = ws_Overlapped;
  434.   ws_Iconic  = ws_Minimize;
  435.   ws_SizeBox = ws_ThickFrame;
  436.  
  437. { Common Window Styles }
  438.  
  439. const
  440.   ws_OverlappedWindow = ws_Overlapped + ws_Caption + ws_SysMenu +
  441.             ws_ThickFrame + ws_MinimizeBox + ws_MaximizeBox;
  442.   ws_PopupWindow      = ws_Popup + ws_Border + ws_SysMenu;
  443.   ws_ChildWindow      = ws_Child;
  444.   ws_TiledWindow      = ws_OverlappedWindow;
  445.  
  446. { Extended Window Styles }
  447.  
  448. const
  449.   ws_ex_DlgModalFrame  = $00000001;
  450.   ws_ex_NoParentNotify = $00000004;
  451.  
  452. { Dialog Box Command IDs }
  453.  
  454. const
  455.   id_Ok     = 1;
  456.   id_Cancel = 2;
  457.   id_Abort  = 3;
  458.   id_Retry  = 4;
  459.   id_Ignore = 5;
  460.   id_Yes    = 6;
  461.   id_No     = 7;
  462.  
  463. { Edit Control Styles }
  464.  
  465. const
  466.   es_Left        = $0000;
  467.   es_Center      = $0001;
  468.   es_Right       = $0002;
  469.   es_MultiLine   = $0004;
  470.   es_UpperCase   = $0008;
  471.   es_LowerCase   = $0010;
  472.   es_Password    = $0020;
  473.   es_AutoVScroll = $0040;
  474.   es_AutoHScroll = $0080;
  475.   es_NoHideSel   = $0100;
  476.   es_OEMConvert  = $0400;
  477.  
  478. { Button Control Styles }
  479.  
  480. const
  481.   bs_PushButton      = $00;
  482.   bs_DefPushButton   = $01;
  483.   bs_CheckBox        = $02;
  484.   bs_AutoCheckBox    = $03;
  485.   bs_RadioButton     = $04;
  486.   bs_3State          = $05;
  487.   bs_Auto3State      = $06;
  488.   bs_GroupBox        = $07;
  489.   bs_UserButton      = $08;
  490.   bs_AutoRadioButton = $09;
  491.   bs_PushBox         = $0A;
  492.   bs_OwnerDraw       = $0B;
  493.   bs_LeftText        = $20;
  494.  
  495. { Static Control Constants }
  496.  
  497. const
  498.   ss_Left           = $00;
  499.   ss_Center         = $01;
  500.   ss_Right          = $02;
  501.   ss_Icon           = $03;
  502.   ss_BlackRect      = $04;
  503.   ss_GrayRect       = $05;
  504.   ss_WhiteRect      = $06;
  505.   ss_BlackFrame     = $07;
  506.   ss_GrayFrame      = $08;
  507.   ss_WhiteFrame     = $09;
  508.   ss_UserItem       = $0A;
  509.   ss_Simple         = $0B;
  510.   ss_LeftNoWordWrap = $0C;
  511.   ss_NoPrefix       = $80;   { Don't do "&" character translation }
  512.  
  513. { Dialog Styles }
  514.  
  515. const
  516.   ds_AbsAlign   = $01;
  517.   ds_SysModal   = $02;
  518.   ds_LocalEdit  = $20;   { Edit items get Local storage }
  519.   ds_SetFont    = $40;   { User specified font for Dlg controls }
  520.   ds_ModalFrame = $80;   { Can be combined with ws_Caption }
  521.   ds_NoIdleMsg  = $100;  { wm_EnterIdle message will not be sent }
  522.  
  523. { Listbox Styles }
  524.  
  525. const
  526.   lbs_Notify            = $0001;
  527.   lbs_Sort              = $0002;
  528.   lbs_NoRedraw          = $0004;
  529.   lbs_MultipleSel       = $0008;
  530.   lbs_OwnerDrawFixed    = $0010;
  531.   lbs_OwnerDrawVariable = $0020;
  532.   lbs_HasStrings        = $0040;
  533.   lbs_UseTabStops       = $0080;
  534.   lbs_NoIntegralHeight  = $0100;
  535.   lbs_MultiColumn       = $0200;
  536.   lbs_WantKeyboardInput = $0400;
  537.   lbs_ExtendedSel       = $0800;
  538.   lbs_Standard          = lbs_Notify + lbs_Sort + ws_VScroll + ws_Border;
  539.  
  540. { Combo Box styles }
  541.  
  542. const
  543.   cbs_Simple            = $0001;
  544.   cbs_DropDown          = $0002;
  545.   cbs_DropDownList      = $0003;
  546.   cbs_OwnerDrawFixed    = $0010;
  547.   cbs_OwnerDrawVariable = $0020;
  548.   cbs_AutoHScroll       = $0040;
  549.   cbs_OEMConvert        = $0080;
  550.   cbs_Sort              = $0100;
  551.   cbs_HasStrings        = $0200;
  552.   cbs_NoIntegralHeight  = $0400;
  553.  
  554. { Scroll Bar Styles }
  555.  
  556. const
  557.   sbs_Horz                    = $0000;
  558.   sbs_Vert                    = $0001;
  559.   sbs_TopAlign                = $0002;
  560.   sbs_LeftAlign               = $0002;
  561.   sbs_BottomAlign             = $0004;
  562.   sbs_RightAlign              = $0004;
  563.   sbs_SizeBoxTopLeftAlign     = $0002;
  564.   sbs_SizeBoxBottomRightAlign = $0004;
  565.   sbs_SizeBox                 = $0008;
  566.  
  567. { Dialog box template resource }
  568.  
  569. type
  570.   PDialogBoxHeader = ^TDialogBoxHeader;
  571.   TDialogBoxHeader = record
  572.     lStyle: LongInt;
  573.     bNumberOfItems: Byte;
  574.     x: Integer;
  575.     y: Integer;
  576.     cx: Integer;
  577.     cy: Integer;
  578.     szMenuName: PChar;
  579.     szClassName: PChar;
  580.     szCaption: PChar;
  581.     wPointSize: Word;
  582.     szFaceName: PChar
  583.   end;
  584.  
  585.   PControlData = ^TControlData;
  586.   TControlData = record
  587.     x: Integer;
  588.     y: Integer;
  589.     cx: Integer;
  590.     cy: Integer;
  591.     wID: Word;
  592.     lStyle: LongInt;
  593.     szClass: PChar;
  594.     szText: PChar;
  595.     bExtraSize: Byte;
  596.     bExtra: array[0..255] of Byte
  597.   end;
  598.  
  599. { Dialog/control class definition }
  600.  
  601. type
  602.   MakeIntClass = PChar;
  603.  
  604. const
  605.   cl_Button    = MakeIntClass($80);
  606.   cl_Edit      = MakeIntClass($81);
  607.   cl_Static    = MakeIntClass($82);
  608.   cl_ListBox   = MakeIntClass($83);
  609.   cl_ScrollBar = MakeIntClass($84);
  610.   cl_ComboBox  = MakeIntClass($85);
  611.  
  612. type
  613.   PLinkRec = ^TLinkRec;
  614.   TLinkRec = record
  615.     Next: PLinkRec;
  616.     proc: pointer; { TLinkProc }
  617.     control: pointer
  618.   end;
  619.  
  620.   PDialogInfo = ^TDialogInfo;
  621.   TDialogInfo = record
  622.     Base: record x, y: Real end;
  623.     Move: TPoint;
  624.     Grow: TPoint;
  625.     Font: Word;
  626.     Links: PLinkRec;
  627.     Group: Boolean;
  628.     Dialog: pointer;
  629.     Wake: pointer;  { TWakeProc }
  630.   end;
  631.  
  632.   PClassRec = ^TClassRec;
  633.   TClassRec = record
  634.     Class: PChar;
  635.     Init: pointer;  { TInitProc }
  636.   end;
  637.  
  638.   TInitProc = procedure(Data: pointer; Info: PDialogInfo);
  639.   TLinkProc = procedure(link, control: pointer);
  640.   TWakeProc = procedure(Info: PDialogInfo);
  641.  
  642. { Data structures for BGI and CPI files **********************************
  643. }
  644.  
  645. { BGI stroked font information
  646. }
  647. type
  648.   TBgiFontInfo = record
  649.     biRes1: Byte;
  650.     biCharCount: Byte;
  651.     biRes2: Byte;
  652.     biRes3: Byte;
  653.     biFirstChar: Byte;
  654.     biVectorOffset: Word;
  655.     biRes4: Byte;
  656.     biPixHeight: Byte;
  657.     biRes5: array[0..6] of Byte;
  658.   { biOffsets: array of Word;
  659.     biWidths: array of Byte }
  660.   End;
  661.  
  662. { CPI file header
  663. }
  664. type
  665.   TCpiFileHeader = record
  666.     cfhSign1: LongInt;
  667.     cfhSign2: LongInt;
  668.     cfhReserved: array[0..16] of Byte
  669.   end;
  670.  
  671. { CPI device/codepage header
  672. }
  673. type
  674.   TCpiDevCpHeader = record
  675.     cdchRes1: Word;
  676.     cdchNext: LongInt;
  677.     cdchRes2: Word;
  678.     cdchDevice: array[0..7] of Char;
  679.     cdchCodePage: Word;
  680.     cdchRes3: array[0..11] of Byte;
  681.     cdchCount: Word;
  682.     cdchRes4: Word
  683.   end;
  684.  
  685. { CPI font header
  686. }
  687. type
  688.   TCpiFontHeader = record
  689.     cfhHeight: Byte;
  690.     cfhWidth: Byte;
  691.     cfhRes1: Word;
  692.     cfhRes2: Word
  693.   end;
  694.  
  695. { Object types *************************************************************
  696. }
  697.  
  698. { Resource name collection, allowing integer and string names
  699. }
  700. type
  701.   PNameCollection = ^TNameCollection;
  702.   TNameCollection = object(TStringCollection)
  703.     function Compare(Key1, Key2: pointer): Integer; virtual;
  704.     procedure FreeItem(Item: pointer); virtual;
  705.   end;
  706.  
  707. { Procedures and functions *************************************************
  708. }
  709.  
  710. function SkipStub(var S: TStream): Boolean;
  711. function SkipToResTbl(var S: TStream): Boolean;
  712. function SkipToResource(var S: TStream; Name, ResType: PChar): Boolean;
  713. function SkipToResourceS(var S: TStream; Name, ResType: PChar): LongInt;
  714.  
  715. function ListResourceNames(var S: TStream; ResType: PChar): PNameCollection;
  716.  
  717. procedure ReadFontInfo(var S: TStream; var FontInfo: TFontInfo;
  718.   FontDir: Boolean);
  719.  
  720. function LoadCursor(var S: TStream; CursorName: PChar): PMyCursor;
  721.  
  722. function LoadBitmap(var S: TStream; BitmapName: PChar): PBitmap;
  723. function LoadBitmapFile(var S: TStream): PBitmap;
  724. procedure DeleteBitmap(Bitmap: PBitmap);
  725.  
  726. function LoadStringBlock(var S: TStream; Index: Word): PStringBlock;
  727. procedure FreeStringBlock(Block: PStringBlock);
  728. function GetStringFromBlock(Block: PStringBlock; Index: Word): PString;
  729. function LoadString(var S: TStream; Index: Word): string;
  730.  
  731. procedure AnsiTo437(Buf: PChar);
  732. procedure AnsiTo437Str(Str: PString);
  733.  
  734. {$IFNDEF VER60    Following routines are not defined for version 6.0.
  735. }
  736.  
  737. function LoadMenu(var S: TStream; MenuName: PChar; Options: Word): pointer;
  738.  
  739. function LoadDialog(var S: TStream; DialogName: PChar): pointer;
  740. procedure InitClasses;
  741. procedure RegisterClass(var ClassRec: TClassRec);
  742. procedure DoneClasses;
  743. procedure InsertLink(Info: PDialogInfo; AProc: pointer; AControl: pointer);
  744. procedure CreateLinks(Info: PDialogInfo; Link: pointer);
  745.  
  746. function ConvertMarkers(Buf: PChar; Max: Word): Boolean;
  747.  
  748. {$ENDIF}
  749.  
  750. implementation
  751.  
  752. uses Memory
  753.  
  754. {$IFNDEF VER60}
  755. , Strings;
  756.  
  757. {$ELSE}
  758. ;
  759.  
  760. { From Strings.pas, Borland Pascal 7.0 Runtime Library,
  761.   Copyright (c) Borland International Inc. 1992
  762. }
  763. function StrIComp(Str1, Str2: PChar): Integer; assembler;
  764. asm
  765.     PUSH    DS
  766.     CLD
  767.     LES    DI,Str2
  768.     MOV    SI,DI
  769.     MOV    CX,0FFFFH
  770.     XOR    AX,AX
  771.     CWD
  772.     REPNE    SCASB
  773.     NOT    CX
  774.     MOV    DI,SI
  775.     LDS    SI,Str1
  776. @@1:    REPE    CMPSB
  777.     JE    @@4
  778.     MOV    AL,DS:[SI-1]
  779.     CMP    AL,'a'
  780.     JB    @@2
  781.     CMP    AL,'z'
  782.     JA    @@2
  783.     SUB    AL,20H
  784. @@2:    MOV    DL,ES:[DI-1]
  785.     CMP    DL,'a'
  786.     JB    @@3
  787.     CMP    DL,'z'
  788.     JA    @@3
  789.     SUB    DL,20H
  790. @@3:    SUB    AX,DX
  791.     JE    @@1
  792. @@4:    POP    DS
  793. end;
  794.  
  795. {$ENDIF}
  796.  
  797. { Internal structure
  798. }
  799. type
  800.   TResInt = record
  801.     riAlignShift: Word;
  802.     riTablePos: LongInt;
  803.     riStream: PStream;
  804.   end;
  805.  
  806. function SkipStub(var S: TStream): Boolean;
  807. var
  808.   ExeHeader: TExeHeader;
  809. begin
  810.   SkipStub := false;
  811.   If S.GetPos > S.GetSize - SizeOf(TExeHeader) then Exit;
  812.   S.Read(ExeHeader, SizeOf(TExeHeader));
  813.   If (ExeHeader.Signature <> $5A4D) or (ExeHeader.eRelocOfs < $40) then Exit;
  814.   S.Seek(ExeHeader.eNewHeader);
  815.   SkipStub := S.Status = 0
  816. End;
  817.  
  818. function SkipToResTbl(var S: TStream): Boolean;
  819. var
  820.   WinHeader: TWinHeader;
  821.   HeaderPos: LongInt;
  822. begin
  823.   SkipToResTbl := false;
  824.   HeaderPos := S.GetPos;
  825.   If HeaderPos > S.GetSize - SizeOf(TWinHeader) then Exit;
  826.   S.Read(WinHeader, SizeOf(TWinHeader));
  827.   If WinHeader.Signature <> $454E then Exit;
  828.   S.Seek(HeaderPos + WinHeader.ResourceTbl);
  829.   SkipToResTbl := S.Status = 0
  830. End;
  831.  
  832. function CompareStrings(Key: PChar; Offset: Word; var ResInt: TResInt): Boolean;
  833. var
  834.   P: LongInt;
  835.   c: array[0..255] of Char;
  836.   l: Byte;
  837. Begin
  838.   CompareStrings := false;
  839.   with ResInt.riStream^ do Begin
  840.     P := GetPos;
  841.     Seek(ResInt.riTablePos + Offset);
  842.     Read(l, 1);
  843.     Read(c, l);
  844.     Seek(P);
  845.   End;
  846.   c[l] := #0;
  847.   CompareStrings := StrIComp(Key, @c) = 0;
  848. End;
  849.  
  850. function Compare(Key: PChar; ID: Word; var ResInt: TResInt): Boolean;
  851. Begin
  852.   If LongRec(Key).Hi = 0
  853.     then if ID < $8000
  854.       then Compare := false
  855.       else Compare := LongRec(Key).Lo = ID and $7FFF
  856.     else if ID < $8000
  857.       then Compare := CompareStrings(Key, ID, ResInt)
  858.       else Compare := false
  859. End;
  860.  
  861. function ReadNameStr(Offset: Word; var ResInt: TResInt): PString;
  862. var
  863.   P: LongInt;
  864.   l: Byte;
  865.   t: PString;
  866. Begin
  867.   with ResInt.riStream^ do Begin
  868.     P := GetPos;
  869.     Seek(ResInt.riTablePos + Offset);
  870.     Read(l, 1);
  871.     GetMem(t, l + 1);
  872.     t^[0] := Chr(l);
  873.     Read(t^[1], l);
  874.     Seek(P)
  875.   End;
  876.   ReadNameStr := t
  877. End;
  878.  
  879. { This procedure fills the ResInt structure. }
  880.  
  881. function SkipToResType(var S: TStream; ResType: PChar;
  882.   var ResInt: TResInt): Word;
  883. var
  884.   ResTable: TResTable;
  885.   TypeInfo: TTypeInfo;
  886. Begin
  887.   SkipToResType := 0;
  888.   ResInt.riTablePos := S.GetPos;
  889.   S.Read(ResInt.riAlignShift, SizeOf(TResTable));
  890.   ResInt.riStream := @S;
  891.   Repeat
  892.     S.Read(TypeInfo, SizeOf(TTypeInfo));
  893.     If TypeInfo.rtTypeID = 0 then Exit else
  894.     if Compare(ResType, TypeInfo.rtTypeID, ResInt) then Begin
  895.       SkipToResType := TypeInfo.rtResourceCount;
  896.       Exit
  897.     End else
  898.       S.Seek(S.GetPos + TypeInfo.rtResourceCount * SizeOf(TNameInfo))
  899.   Until false
  900. End;
  901.  
  902. function SkipToResourceS(var S: TStream; Name, ResType: PChar): LongInt;
  903. var
  904.   Count: Word;
  905.   NameInfo: TNameInfo;
  906.   ResInt: TResInt;
  907.   i: Word;
  908. begin
  909.   SkipToResourceS := 0;
  910.   For i := 1 to SkipToResType(S, ResType, ResInt) do Begin
  911.     S.Read(NameInfo, SizeOf(TNameInfo));
  912.     If (Name = nil) or Compare(Name, NameInfo.rnID, ResInt) then Begin
  913.       S.Seek(LongInt(NameInfo.rnOffset) shl ResInt.riAlignShift);
  914.       { Size is given in alignment units, and not in bytes, as the
  915.     documentation erroneously states. }
  916.       SkipToResourceS := NameInfo.rnLength shl ResInt.riAlignShift;
  917.       Exit
  918.     End;
  919.   End;
  920. End;
  921.  
  922. function SkipToResource(var S: TStream; Name, ResType: PChar): Boolean;
  923. Begin
  924.   SkipToResource := SkipToResourceS(S, Name, ResType) <> 0
  925. End;
  926.  
  927. function ListResourceNames(var S: TStream; ResType: PChar): PNameCollection;
  928. var
  929.   coll: PNameCollection;
  930.   NameInfo: TNameInfo;
  931.   ResInt: TResInt;
  932.   i, count: Word;
  933.   n: LongInt;
  934. Begin
  935.   count := SkipToResType(S, ResType, ResInt);
  936.   If count = 0 then Begin
  937.     ListResourceNames := nil;
  938.     Exit
  939.   End;
  940.   coll := New(PNameCollection, Init(count, 8));
  941.   For i := 1 to count do Begin
  942.     S.Read(NameInfo, SizeOf(TNameInfo));
  943.     If NameInfo.rnID < $8000
  944.     then coll^.Insert(ReadNameStr(NameInfo.rnID, ResInt))
  945.     else Begin
  946.       n := NameInfo.rnID and $7FFF;
  947.       coll^.Insert(pointer(n))
  948.     End
  949.   End;
  950.   ListResourceNames := coll
  951. End;
  952.  
  953. { TNameCollection object
  954. }
  955.  
  956. function TNameCollection.Compare(Key1, Key2: pointer): Integer;
  957. Begin
  958.   If (Seg(Key1^) = 0) or (Seg(Key2^) = 0) then
  959.     if LongInt(Key1) > LongInt(Key2) then Compare := +1 else
  960.     if LongInt(Key1) < LongInt(Key2) then Compare := -1 else Compare := 0
  961.   else Compare := TStringCollection.Compare(Key1, Key2)
  962. End;
  963.  
  964. procedure TNameCollection.FreeItem(Item: pointer);
  965. Begin
  966.   If Seg(Item^) <> 0 then TStringCollection.FreeItem(Item)
  967. End;
  968.  
  969. { Font routines
  970. }
  971.  
  972. procedure ReadFontInfo(var S: TStream; var FontInfo: TFontInfo;
  973.   FontDir: Boolean);
  974. var
  975.   C: Char;
  976. Begin
  977.   FillChar(FontInfo, SizeOf(TFontInfo), 0);
  978.   If FontDir
  979.     then S.Read(FontInfo, FontInfoBaseSize - 5)
  980.     else Begin
  981.       FontInfo.dfResID:=0;
  982.       S.Read(FontInfo.dfVersion, FontInfoBaseSize - 3);
  983.       case FontInfo.dfVersion of
  984.     $200:
  985.       S.Read(FontInfo.dfReserved, 1);
  986.     $300:
  987.     Begin
  988.       S.Read(FontInfo.dfReserved, 1);
  989.       S.Read(FontInfo.dfFlags, FontInfoExtraSize);
  990.       S.Seek(S.GetPos + 16)
  991.     End;
  992.       End;
  993.     End;
  994.   If FontDir then Begin
  995.     Repeat S.Read(C, 1) until C = #0;    { Devicename }
  996.     Repeat S.Read(C, 1) until C = #0;    { Facename }
  997.   End
  998. End;
  999.  
  1000. { Cursor routines
  1001. }
  1002.  
  1003. procedure ConvertMask(var Source; var Dest); assembler;
  1004. asm
  1005.     push    ds
  1006.     lds    si, Source
  1007.     les    di, Dest
  1008.     cld
  1009.     mov    cx, 32
  1010.     add    di, 64
  1011. @@1:    sub    di, 2
  1012.     lodsw
  1013.     xchg    ah, al
  1014.     mov    es:[di], ax
  1015.     lodsw
  1016.     xchg    ah, al
  1017.     mov    es:[di].64, ax
  1018.     loop    @@1
  1019.     pop    ds
  1020. end;
  1021.  
  1022. function LoadCursor(var S: TStream; CursorName: PChar): PMyCursor;
  1023. var
  1024.   p: LongInt;
  1025.   c: PMyCursor;
  1026.   CursorRes: TCursorRes;
  1027.   Mask: array[0..127] of Byte;
  1028. Begin
  1029.   p := S.GetPos;
  1030.   c := nil;
  1031.   If SkipToResource(S, CursorName, rt_Cursor) then Begin
  1032.     S.Read(CursorRes, SizeOf(TCursorRes));
  1033.     New(c);
  1034.     with c^ do
  1035.     with CursorRes do Begin
  1036.       mcHotSpotX := crHotSpotX;
  1037.       mcHotSpotY := crHotSpotY;
  1038.       with crHeader do Begin
  1039.     mcHeight := 32 {biHeight div 2};
  1040.     mcWidth := 4 {biHeight div 8};
  1041.     S.Seek(S.GetPos + 1 shl biBitCount * SizeOf(TRGBQuad))
  1042.       End;
  1043.       S.Read(Mask, 128);
  1044.       ConvertMask(mask, mcXOR);
  1045.       S.Read(Mask, 128);
  1046.       ConvertMask(mask, mcAND)
  1047.     End
  1048.   End;
  1049.   S.Seek(p);
  1050.   LoadCursor := c
  1051. End;
  1052.  
  1053. { Bitmap routines
  1054. }
  1055.  
  1056. function DoLoadBitmap(var S: TStream; Size: LongInt): PBitmap;
  1057. var
  1058.   pos: LongInt;
  1059.   Bitmap: PBitmap;
  1060.   Struct: LongInt;
  1061.   Comp: Word;
  1062.  
  1063.  procedure ReadCoreHeader;
  1064.  var
  1065.    BitmapCoreHeader: TBitmapCoreHeader;
  1066.    Delta: LongInt;
  1067.  Begin
  1068.    New(Bitmap);
  1069.    with BitmapCoreHeader, Bitmap^ do Begin
  1070.      S.Read(bcWidth, SizeOf(TBitmapCoreHeader) - 4);
  1071.      bmWidth := bcWidth;
  1072.      bmHeight := bcHeight;
  1073.      bmPlanes := bcPlanes;
  1074.      bmBitsPixel := bcBitCount;
  1075.      Comp := bi_RGB;
  1076.      Delta := SizeOf(TBitmapCoreHeader);
  1077.      If bcBitCount < 24
  1078.      then Inc(Delta, SizeOf(TRGBTriple) shl bcBitCount);
  1079.      S.Seek(pos + Delta);
  1080.      Dec(Size, Delta)
  1081.    End
  1082.  End;
  1083.  
  1084.  procedure ReadInfoHeader;
  1085.  var
  1086.    BitmapInfoHeader: TBitmapInfoHeader;
  1087.    Delta: LongInt;
  1088.  Begin
  1089.    New(Bitmap);
  1090.    with BitmapInfoHeader, Bitmap^ do Begin
  1091.      S.Read(biWidth, SizeOf(TBitmapInfoHeader) - 4);
  1092.      bmWidth := biWidth;
  1093.      bmHeight := biHeight;
  1094.      bmPlanes := biPlanes;
  1095.      bmBitsPixel := biBitCount;
  1096.      Comp := biCompression;
  1097.      Delta := SizeOf(TBitmapInfoHeader);
  1098.      If biBitCount < 24
  1099.      then Inc(Delta, SizeOf(TRGBQuad) shl biBitCount);
  1100.      S.Seek(pos + Delta);
  1101.      Dec(Size, Delta)
  1102.    End
  1103.  End;
  1104.  
  1105.  procedure CalcWidthBytes;
  1106.  Begin
  1107.    with Bitmap^ do
  1108.      bmWidthBytes := ((bmWidth * bmBitsPixel + 31) shr 3) and $FFFC
  1109.  End;
  1110.  
  1111. Begin
  1112.   DoLoadBitmap := nil;
  1113.   pos := S.GetPos;
  1114.   S.Read(Struct, 4);
  1115.   If Struct = SizeOf(TBitmapCoreHeader) then ReadCoreHeader else
  1116.   if Struct = SizeOf(TBitmapInfoHeader) then ReadInfoHeader else Exit;
  1117.   CalcWidthBytes;
  1118.   with Bitmap^ do Begin
  1119.     bmType := 0;
  1120.     GetMem(bmBits, bmHeight * bmWidthBytes);
  1121.     If bmBits <> nil
  1122.     then Begin
  1123.       case Comp of
  1124.     bi_RGB:
  1125.       S.Read(bmBits^, bmHeight * bmWidthBytes);
  1126.     bi_RLE4, bi_RLE8:
  1127.       Begin
  1128.         (*GetMem(Code, Size);
  1129.         If Code <> nil then Begin
  1130.           S.Read(Code^, Size);
  1131.  
  1132.           { Expanding compressed bitmaps is not implemented yet...
  1133.         ... but soon. }
  1134.  
  1135.           FreeMem(Code, Size)
  1136.         End
  1137.         else*) Begin
  1138.           Dispose(Bitmap);
  1139.           Exit
  1140.         End
  1141.       End
  1142.       end;
  1143.       DoLoadBitmap := Bitmap
  1144.     End
  1145.     else Dispose(Bitmap)
  1146.   End
  1147. End;
  1148.  
  1149. function LoadBitmap(var S: TStream; BitmapName: PChar): PBitmap;
  1150. var
  1151.   p, Size: LongInt;
  1152. Begin
  1153.   p := S.GetPos;
  1154.   Size := SkipToResourceS(S, BitmapName, rt_Bitmap);
  1155.   If Size <> 0
  1156.   then LoadBitmap := DoLoadBitmap(S, Size)
  1157.   else LoadBitmap := nil;
  1158.   S.Seek(P);
  1159. End;
  1160.  
  1161. function LoadBitmapFile(var S: TStream): PBitmap;
  1162. var
  1163.   BitmapFileHeader: TBitmapFileHeader;
  1164. Begin
  1165.   S.Read(BitMapFileHeader, SizeOf(TBitmapFileHeader));
  1166.   with BitMapFileHeader do
  1167.     If bfType = $4D42
  1168.     then LoadBitmapFile := DoLoadBitmap(S, bfSize)
  1169.     else LoadBitmapFile := nil
  1170. End;
  1171.  
  1172. procedure DeleteBitmap(Bitmap: PBitmap);
  1173. Begin
  1174.   If Bitmap <> nil then Begin
  1175.     with Bitmap^ do
  1176.       FreeMem(bmBits, bmHeight * bmWidthBytes);
  1177.     Dispose(Bitmap)
  1178.   End
  1179. End;
  1180.  
  1181. { Code page routines
  1182. }
  1183.  
  1184. procedure T10070437; external;
  1185.  
  1186. {$L 10070437.obj (10070437.bin) }
  1187.  
  1188. procedure T04371007; external;
  1189.  
  1190. {$L 04371007.obj (04371007.bin) }
  1191.  
  1192. procedure AnsiTo437(Buf: PChar); external;
  1193. procedure AnsiTo437Str(Str: PString); external;
  1194.  
  1195. procedure AnsiTo437Buf(var Buf); near; external;
  1196.  
  1197. {$L WResChr.obj  (WResChr.asm)         WinRes: Character translation }
  1198.  
  1199. { String resource routines
  1200. }
  1201.  
  1202. function LoadStringBlock(var S: TStream; Index: Word): PStringBlock;
  1203. var
  1204.   P, Q, Size: LongInt;
  1205.   Block: PStringBlock;
  1206. Begin
  1207.   LoadStringBlock := nil;
  1208.   P := S.GetPos;
  1209.   size := SkipToResourceS(S, MakeIntResource(Index shr 4 + 1), rt_String);
  1210.   If size <> 0 then Begin
  1211.     Q := S.GetPos;
  1212.     GetMem(Block, SizeOf(TStringBlock) + size);
  1213.     LoadStringBlock := Block;
  1214.     with Block^ do Begin
  1215.       sbIndex := Index shr 4 + 1;
  1216.       sbSize := size;
  1217.       sbNext := nil;
  1218.       S.Read(sbData, size);
  1219.       AnsiTo437Buf(sbData)
  1220.     End
  1221.   End;
  1222.   S.Seek(P)
  1223. End;
  1224.  
  1225. procedure FreeStringBlock(Block: PStringBlock);
  1226. Begin
  1227.   If Block <> nil then
  1228.   FreeMem(Block, SizeOf(TStringBlock) + Block^.sbSize)
  1229. End;
  1230.  
  1231. function GetStringFromBlock(Block: PStringBlock; Index: Word): PString; external;
  1232.  
  1233. {$L WResStr.obj  (WResStr.asm)        WinRes: strings }
  1234.  
  1235. function LoadString(var S: TStream; Index: Word): string;
  1236. var
  1237.   P, Cur: LongInt;
  1238.   i: Integer;
  1239.   d: Byte;
  1240.   str: PString;
  1241. Begin
  1242.   P := S.GetPos;
  1243.   If SkipToResource(S, MakeIntResource(Index shr 4 + 1), rt_String)
  1244.   then Begin
  1245.     Cur := S.GetPos;
  1246.     For i := 1 to Index and 15 do Begin
  1247.       S.Read(d, 1);
  1248.       Inc(Cur, d + 1);
  1249.       S.Seek(Cur)
  1250.     End;
  1251.     asm
  1252.     les    di, @Result
  1253.     mov    WORD PTR str, di
  1254.     mov    WORD PTR str.2, es
  1255.     end;
  1256.     S.Read(str^[0], 1);
  1257.     S.Read(str^[1], Length(str^));
  1258.     AnsiTo437Str(str)
  1259.   End
  1260.   else LoadString := '';
  1261.   S.Seek(P)
  1262. End;
  1263.  
  1264. {$IFNDEF VER60 *************************************************************}
  1265.  
  1266. { String zero routines
  1267. }
  1268.  
  1269. procedure ReadSZ(var S: TStream; Buf: PChar); near;
  1270. var
  1271.   C: Char;
  1272.   cnt: Word;
  1273. Begin
  1274.   cnt := 0;
  1275.   Repeat
  1276.     S.Read(C, 1);
  1277.     Buf[0] := C;
  1278.     If cnt < 256 then Inc(Buf);
  1279.     Inc(cnt)
  1280.   Until C = #0;
  1281. End;
  1282.  
  1283. function ReadNewSZ(var S: TStream; Buf: PChar): PChar; near;
  1284. Begin
  1285.   ReadSZ(S, Buf);
  1286.   ReadNewSZ := StrNew(Buf)
  1287. End;
  1288.  
  1289. procedure DisposeSZ(Buf: PChar); near;
  1290. Begin
  1291.   If Seg(Buf^) <> 0 then StrDispose(Buf)
  1292. End;
  1293.  
  1294. { Marker routines
  1295. }
  1296.  
  1297. function ConvertMarkers(Buf: PChar; Max: Word): Boolean;
  1298. var
  1299.   M: PChar;
  1300. Begin
  1301.   ConvertMarkers := false;
  1302.   M := Buf + Max;
  1303.   Repeat
  1304.     Buf := StrScan(Buf, '&');
  1305.     If Buf <> nil then
  1306.     if Buf[1] = '&'
  1307.     then Begin                    { &&  & }
  1308.       StrMove(Buf + 1, Buf, StrLen(Buf));
  1309.       Inc(Buf, 2)
  1310.     End
  1311.     else Begin                    { &a  ~a~ }
  1312.       ConvertMarkers := true;
  1313.       Buf[0] := '~';
  1314.       If StrEnd(Buf) = M - 1
  1315.       then StrMove(Buf + 3, Buf + 2, StrLen(Buf+3))
  1316.       else StrMove(Buf + 3, Buf + 2, StrLen(Buf+1));
  1317.       Buf[2] := '~';
  1318.       Inc(Buf, 3)
  1319.     End;
  1320.   Until (Buf >= M) or (Buf = nil)
  1321. End;
  1322.  
  1323. { Menu routines
  1324. }
  1325. const
  1326.   dfDisabled   = $01;
  1327.   dfMenuCheck  = $02;
  1328.   dfRadio      = $04;
  1329.   dfCheckState = $08;
  1330.   dfBitmap     = $10;
  1331.  
  1332. type
  1333.   PMenu = ^TMenu;
  1334.  
  1335.   PMenuItem = ^TMenuItem;
  1336.   TMenuItem = record
  1337.     Next: PMenuItem;
  1338.     Name: PString;
  1339.     Command: Word;
  1340.     Disabled: Byte;
  1341.     KeyCode: Word;
  1342.     HelpCtx: Word;
  1343.     case Integer of
  1344.       0: (Param: PString);
  1345.       1: (SubMenu: PMenu);
  1346.   end;
  1347.  
  1348.   TMenu = record
  1349.     Items: PMenuItem;
  1350.     Default: PMenuItem;
  1351.   end;
  1352.  
  1353. function LoadMenu(var S: TStream; MenuName: PChar; Options: Word): pointer;
  1354. var
  1355.   P: LongInt;
  1356.   MenuHeader: TMenuHeader;
  1357.  
  1358.  function DoLoadMenu: PMenu;
  1359.  var
  1360.    Menu: PMenu;
  1361.    Res, Item: PMenuItem;
  1362.    Flags: Word;
  1363.    Prefix: string[2];
  1364.    Buf: array[0..255] of Char;
  1365.    P: PChar;
  1366.  Begin
  1367.    New(Menu); FillChar(Menu^, SizeOf(Menu^), 0);
  1368.    DoLoadMenu := Menu;
  1369.    Res := nil;
  1370.    Repeat
  1371.      S.Read(Flags, SizeOf(Word));
  1372.      New(Item);
  1373.      If Res = nil then Begin
  1374.        Menu^.Items := Item;
  1375.        Menu^.Default := Item
  1376.      End else Res^.Next := Item;
  1377.      Res := Item;
  1378.      with Item^ do Begin
  1379.        Next := nil;
  1380.        Boolean(Disabled) := Flags and (mf_Grayed + mf_Disabled) <> 0;
  1381.        KeyCode := 0;
  1382.        HelpCtx := 0;
  1383.        If Flags and mf_PopUp = 0 then Begin
  1384.      S.Read(Command, SizeOf(Word));
  1385.      ReadSZ(S, Buf);
  1386.      AnsiTo437(Buf);
  1387.      P := StrScan(Buf, #9);
  1388.      If P <> nil then Begin
  1389.        P[0] := #0;
  1390.        Param := NewStr(StrPas(P+1))
  1391.      End
  1392.      else Param := nil;
  1393.      Prefix := '';
  1394.      If Flags and mf_Checked <> 0 then
  1395.      if Options = mo_GraphicsVision
  1396.        then Disabled := Disabled or (dfMenuCheck + dfCheckState)
  1397.        else Prefix := ' ';
  1398.      ConvertMarkers(Buf, 256);
  1399.      Name := NewStr(Prefix + StrPas(Buf))
  1400.        End
  1401.        else Begin
  1402.      Command := 0;
  1403.      ReadSZ(S, Buf);
  1404.      AnsiTo437(Buf);
  1405.      ConvertMarkers(Buf, 256);
  1406.      Name := NewStr(StrPas(Buf));
  1407.      SubMenu := DoLoadMenu
  1408.        End
  1409.      End
  1410.    Until Flags and mf_End <> 0;
  1411.  End;
  1412.  
  1413. Begin
  1414.   P := S.GetPos;
  1415.   If SkipToResource(S, MenuName, rt_Menu) then Begin
  1416.     S.Read(MenuHeader, SizeOf(TMenuHeader));
  1417.     LoadMenu := DoLoadMenu
  1418.   End else LoadMenu := nil;
  1419.   S.Seek(P);
  1420. End;
  1421.  
  1422. { Dialog template routines
  1423. }
  1424.  
  1425. type
  1426.   PClassCollection = ^TClassCollection;
  1427.   TClassCollection = object(TSortedCollection)
  1428.     function Compare(Key1, Key2: Pointer): Integer; virtual;
  1429.     procedure FreeItem(Item: Pointer); virtual;
  1430.   End;
  1431.  
  1432. function TClassCollection.Compare;
  1433. var
  1434.   C1, C2: PChar;
  1435. Begin
  1436.   C1 := PClassRec(Key1)^.Class;
  1437.   C2 := PClassRec(Key2)^.Class;
  1438.   If (Seg(C1^) = 0) or (Seg(C2^) = 0) then
  1439.     if LongInt(C1) > LongInt(C2) then Compare := +1 else
  1440.     if LongInt(C1) < LongInt(C2) then Compare := -1 else Compare := 0
  1441.   else Compare := StrIComp(C1, C2)
  1442. End;
  1443.  
  1444. procedure TClassCollection.FreeItem;
  1445. Begin
  1446.   { don't free }
  1447. End;
  1448.  
  1449. const
  1450.   Classes: PSortedCollection = nil;
  1451.  
  1452. procedure InitClasses;
  1453. Begin
  1454.   Classes := New(PClassCollection, Init(8, 8))
  1455. End;
  1456.  
  1457. procedure DoneClasses;
  1458. Begin
  1459.   Dispose(Classes, Done);
  1460.   Classes := nil
  1461. End;
  1462.  
  1463. procedure RegisterClass(var ClassRec: TClassRec);
  1464. var
  1465.   Index: Integer;
  1466. Begin
  1467.   If Classes = nil then Begin
  1468.     InitClasses;
  1469.     If Classes = nil then Exit
  1470.   End;
  1471.   with Classes^ do Begin
  1472.     If Search(@ClassRec, Index) then AtDelete(Index);
  1473.     AtInsert(Index, @ClassRec)
  1474.   End
  1475. End;
  1476.  
  1477. function GetClass(ClassName: PChar): PClassRec; near;
  1478. var
  1479.   Index: Integer;
  1480.   Rec: TClassRec;
  1481. Begin
  1482.   Rec.Class := ClassName;
  1483.   If Classes^.Search(@Rec, Index)
  1484.   then GetClass := Classes^.At(Index)
  1485.   else GetClass := nil
  1486. End;
  1487.  
  1488. function LoadDialog(var S: TStream; DialogName: PChar): pointer;
  1489. var
  1490.   Header: TDialogBoxHeader;
  1491.   Control: TControlData;
  1492.   Info: TDialogInfo;
  1493.   Buf: array[0..255] of Char;
  1494.   DlgClass, Class: PClassRec;
  1495.   Pos: LongInt;
  1496.   i: Byte;
  1497. Begin
  1498.   Pos := S.GetPos;
  1499.   LoadDialog := nil;
  1500.   If SkipToResource(S, DialogName, rt_Dialog) then Begin
  1501.     S.Read(Header, 13);
  1502.     with Header do Begin
  1503.       FillChar(szMenuName, SizeOf(TDialogBoxHeader) - 13, 0);
  1504.       S.Read(Buf, 1);
  1505.       If Buf[0] = #255 then S.Read(szMenuName, 2) else
  1506.       if Buf[0] <> #0 then Begin
  1507.     ReadSZ(S, Buf+1);
  1508.     szMenuName := StrNew(Buf)
  1509.       End;
  1510.       szClassname := ReadNewSZ(S, Buf);
  1511.       szCaption := ReadNewSZ(S, Buf);
  1512.       If szCaption <> nil then AnsiTo437(szCaption);
  1513.       If lStyle and ds_SetFont <> 0 then Begin
  1514.     S.Read(wPointSize, 2);
  1515.     szFaceName := ReadNewSZ(S, Buf)
  1516.       End;
  1517.       If Classes = nil
  1518.     then DlgClass := nil
  1519.     else DlgClass := GetClass(szClassname);
  1520.       If DlgClass = nil
  1521.     then Info.Dialog := nil
  1522.     else TInitProc(DlgClass^.Init)(@Header, @Info);
  1523.       DisposeSZ(szMenuName);
  1524.       DisposeSZ(szClassname);
  1525.       DisposeSZ(szCaption);
  1526.       DisposeSZ(szFaceName);
  1527.       If Info.Dialog <> nil then Begin
  1528.     For i := 1 to bNumberOfItems do Begin
  1529.       S.Read(Control, 14);
  1530.       with Control do Begin
  1531.         S.Read(Buf, 1);
  1532.         If Buf[0] >= #$80 then LongInt(szClass) := Byte(Buf[0]) else
  1533.         if Buf[0] = #0 then szClass := nil else Begin
  1534.           ReadSZ(S, Buf+1);
  1535.           szClass := StrNew(Buf)
  1536.         End;
  1537.         szText := ReadNewSZ(S, Buf);
  1538.         If szText <> nil then AnsiTo437(szText);
  1539.         S.Read(bExtraSize, 1);
  1540.         If bExtraSize <> 0 then
  1541.         S.Read(bExtra, bExtraSize);
  1542.         Class := GetClass(szClass);
  1543.         If Class <> nil then
  1544.           TInitProc(Class^.Init)(@Control, @Info);
  1545.         DisposeSZ(szClass);
  1546.         DisposeSZ(szText)
  1547.       End
  1548.     End;
  1549.     If Info.Wake <> nil then
  1550.     TWakeProc(Info.Wake)(@Info)
  1551.       End
  1552.     End;
  1553.     LoadDialog := Info.Dialog
  1554.   End;
  1555.   S.Seek(Pos)
  1556. End;
  1557.  
  1558. procedure CreateLinks(Info: PDialogInfo; Link: pointer);
  1559. var
  1560.   N, P: PLinkRec;
  1561. Begin
  1562.   P := Info^.Links;
  1563.   Info^.Links := nil;
  1564.   while P <> nil do
  1565.     with P^ do Begin
  1566.       TLinkProc(proc)(link, control);
  1567.       N := Next;
  1568.       Dispose(P);
  1569.       P := N
  1570.     End
  1571. End;
  1572.  
  1573. procedure InsertLink(Info: PDialogInfo; AProc: pointer; AControl: pointer);
  1574. var
  1575.   Link: PLinkRec;
  1576. Begin
  1577.   New(Link);
  1578.   with Link^ do Begin
  1579.     Next := Info^.Links;
  1580.     Proc := AProc;
  1581.     Control := AControl
  1582.   End;
  1583.   Info^.Links := Link
  1584. End;
  1585.  
  1586. {$ENDIF}
  1587.  
  1588. End.
  1589.